<%
'远程文件操作类

Class Class_KnifeCMS_Http
	
	Private S_TempString,Pv_RelFilePath,Pv_AbsFilePath
	
	Public Function ReplaceRemoteUrl(ByVal BV_Content,ByVal BV_ImgRep, ByVal BV_rarzipRep, ByVal BV_flashRep, ByVal BV_Debug)
		S_TempString     = BV_Content
		ReplaceRemoteUrl = BV_Content
		BV_ImgRep    = Cbool(BV_ImgRep)
		BV_rarzipRep = Cbool(BV_rarzipRep)
		BV_flashRep  = Cbool(BV_flashRep)
		BV_Debug     = CBool(BV_Debug)
		If (BV_ImgRep=False And BV_rarzipRep=False And BV_flashRep=False) Or Trim(S_TempString)="" Then
			Exit Function
		End If
		If KnifeCMS.IsObjInstalled("Microsoft.XMLHTTP")=False Or KnifeCMS.IsFSOInstalled=False Then
			Exit Function
		End If
		Dim Files_i,RemoteFile,RemoteFiles,RemoteFileUrl,RemoteFileExt,GetResult
		Dim regEx,LocalFileName,FilePath,FileName
		Dim FolderPath,ImgFolderPath,RarZipFolderPath,FlashFolderPath
		Dim regExSuf,regExImg,regExrarzip,regExflash
		Dim FileUrlsArr,FileUrlsArr_i
		    FolderPath = KnifeCMS.Data.FormatDateTime(SysTime,5) & KnifeCMS.Data.FormatDateTime(SysTime,6) &"/"& KnifeCMS.Data.FormatDateTime(SysTime,7) '年月日文件夹
		    ImgFolderPath    = "attachment/image/"  & FolderPath
			RarZipFolderPath = "attachment/rarzip/" & FolderPath
			FlashFolderPath  = "attachment/flash/"  & FolderPath
			Set regEx=new RegExp
			regEx.IgnoreCase = True
			regEx.Global     = True
			'采集图片
			If BV_ImgRep=True Or BV_ImgRep=1 Then
				Pv_RelFilePath = ImgFolderPath
				Pv_AbsFilePath = KnifeCMS.FSO.CreateFolder(Pv_RelFilePath)
				Echo Pv_AbsFilePath&"<br>"
				'如果创建文件夹失败则提示错误信息并退出Function
				If Pv_AbsFilePath=False Then Print "<br> Can't Create Folder " & Pv_AbsFilePath &"<br>" : Exit Function
				regEx.Pattern   = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}([\w\-]+[.]){1,}(net|com|cn|org|cc|tv|[0-9]{1,3})(\S*\/)((\S)+[.]{1}(gif|jpg|jpeg|jpe|bmp|png)))"
			    Set RemoteFiles = regEx.Execute(S_TempString)
				'用函数去掉相同的地址再开始采集图片
				FileUrlsArr=KnifeCMS.Data.ClearSameDatas(RemoteFiles,1)
				If FileUrlsArr(0)<>"$err$" Then
					For Files_i=0 To Ubound(FileUrlsArr)
						RemoteFileUrl  = FileUrlsArr(Files_i)
						RemoteFileExt  = LCase(Mid(RemoteFileUrl,InStrRev(RemoteFileUrl,".")+1))
						FileName       = KnifeCMS.Data.Left(UploadFile_Pre & KnifeCMS.Data.FormatDateTime(Now(),9) & KnifeCMS.MakeRandom(6) & KnifeCMS.MakeRandom(6) & KnifeCMS.MakeRandom(6),32) &"."& RemoteFileExt
						LocalFileName  = Pv_RelFilePath &"/"& FileName
						Print " Collecting the "&Files_i+1&" pic ["& RemoteFileUrl &"]............<br>"
						If BV_Debug Then : GetResult=True : Else : GetResult=SaveRemoteFile(Pv_AbsFilePath &"\"& FileName,RemoteFileUrl) : End If
						If GetResult=False Then
							Print " <font style=""color:#FE0107"">Error: Collected  the "&Files_i&" pic failured.</font><br>"
						Else
							Print " Collected  the "&Files_i+1&" pic successfully , Save LocalPath is "&LocalFileName&"<br>"
						End If
						S_TempString = Replace(S_TempString,RemoteFileUrl,SystemPath & LocalFileName)
					Next
				End If
			End If
			'采集(zip/rar)文件
			If BV_rarzipRep Then
			    Pv_RelFilePath = RarZipFolderPath
				Pv_AbsFilePath = KnifeCMS.FSO.CreateFolder(Pv_RelFilePath)
				'如果创建文件夹失败则提示错误信息并退出Function
				If Pv_AbsFilePath=False Then Print "<br> Can't Create Folder " & Pv_AbsFilePath &"<br>" : Exit Function
				regEx.Pattern   = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}([\w\-]+[.]){1,}(net|com|cn|org|cc|tv|[0-9]{1,3})(\S*\/)((\S)+[.]{1}(rar|zip)))"
			    Set RemoteFiles = regEx.Execute(S_TempString)
				'用函数去掉相同的地址再开始采集图片
				FileUrlsArr=KnifeCMS.Data.ClearSameDatas(RemoteFiles,1)
				If FileUrlsArr(0)<>"$err$" Then
					For Files_i=0 To Ubound(FileUrlsArr)
						RemoteFileUrl  = FileUrlsArr(Files_i)
						RemoteFileExt  = LCase(Mid(RemoteFileUrl,InStrRev(RemoteFileUrl,".")+1))
						FileName       = KnifeCMS.Data.Left(UploadFile_Pre & KnifeCMS.Data.FormatDateTime(SysTime,8) & KnifeCMS.MakeRandom(8) & KnifeCMS.MakeRandom(8) & KnifeCMS.MakeRandom(8),32) &"."& RemoteFileExt
						LocalFileName  = Pv_RelFilePath &"/"& FileName
						Print " Collecting the "&Files_i+1&" file ["&RemoteFileUrl&"]............<br>"
						If BV_Debug Then : GetResult=True : Else : GetResult=SaveRemoteFile(Pv_AbsFilePath &"\"& FileName,RemoteFileUrl) : End If
						If GetResult=False Then
							Print " <font style=""color:#FE0107"">Error: Collected  the "&Files_i&" file failured.</font><br>"
						Else
							Print " Collected  the "&Files_i+1&" file successfully , Save LocalPath is "&LocalFileName&"<br>"
						End If
						S_TempString = Replace(S_TempString,RemoteFileUrl,SystemPath & LocalFileName)
					Next
				End If
			End If
			'采集Falsh
			If BV_flashRep Then
			    Pv_RelFilePath = RarZipFolderPath
				Pv_AbsFilePath = KnifeCMS.FSO.CreateFolder(Pv_RelFilePath)
				'如果创建文件夹失败则提示错误信息并退出Function
				If Pv_AbsFilePath=False Then Response.Write "<br> Can't Create Folder " & Pv_AbsFilePath &"<br>" : Exit Function
				regEx.Pattern   = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}([\w\-]+[.]){1,}(net|com|cn|org|cc|tv|[0-9]{1,3})(\S*\/)((\S)+[.]{1}(swf)))"
			    Set RemoteFiles = regEx.Execute(S_TempString)
				'用函数去掉相同的地址再开始采集图片
				FileUrlsArr=KnifeCMS.Data.ClearSameDatas(RemoteFiles,1)
				If FileUrlsArr(0)<>"$err$" Then
					For Files_i=0 To Ubound(FileUrlsArr)
						RemoteFileUrl  = FileUrlsArr(Files_i)
						RemoteFileExt  = LCase(Mid(RemoteFileUrl,InStrRev(RemoteFileUrl,".")+1))
						FileName       = KnifeCMS.Data.Left(UploadFile_Pre & KnifeCMS.Data.FormatDateTime(SysTime,8) & KnifeCMS.MakeRandom(8) & KnifeCMS.MakeRandom(8) & KnifeCMS.MakeRandom(8),32) &"."& RemoteFileExt
						LocalFileName  = Pv_RelFilePath &"/"& FileName
						Print " Collecting the "&Files_i+1&" flash["&RemoteFileUrl&"]............<br>"
						If BV_Debug Then : GetResult=True : Else : GetResult=SaveRemoteFile(Pv_AbsFilePath &"\"& FileName,RemoteFileUrl) : End If
						If GetResult=False Then
						  Print " <font style=""color:#FE0107"">Error: Collected  the "&Files_i&" flash failured.</font><br>"
						Else
						  Print " Collected  the "&Files_i+1&" flash successfully , Save LocalPath is "&LocalFileName&"<br>"
						End If
						S_TempString = Replace(S_TempString,RemoteFileUrl,SystemPath & LocalFileName)
					Next
				End If
			End If
		ReplaceRemoteUrl = S_TempString
	End Function
	
	'BV_LocalFileName为绝对文件路径
	Public Function SaveRemoteFile(ByVal BV_LocalFileName, ByVal BV_RemoteFileUrl)
		SaveRemoteFile = False
		If BV_LocalFileName="" or IsNull(BV_LocalFileName) or BV_RemoteFileUrl="" or IsNull(BV_RemoteFileUrl) then
			Exit Function
		End If
		On Error Resume Next
		Dim Ads, Retrieval, GetRemoteData
		Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
		With Retrieval
			.Open "Get", BV_RemoteFileUrl, False, "", ""
			.Send
			GetRemoteData = .ResponseBody
		End With
		'response.Write InStr(Retrieval.ResponseBody,"body") 
		If Err.Number <> 0 Then'如若采集失败则退出Function
			Err.Clear
			Response.Write "Error:" & BV_RemoteFileUrl & " Get Failed <br>"
			Exit Function
		End If
		Set Retrieval = Nothing
		Set Ads = Server.CreateObject("Adodb.Stream")
		'Echo "<br>================"& Server.MapPath(BV_LocalFileName) &"================<br>"
		With Ads
			.Type = 1
			.Open
			.Write GetRemoteData
			'.SaveToFile Server.MapPath(BV_LocalFileName), 2
			.SaveToFile BV_LocalFileName, 2
			.Cancel
			.Close
		End With
		Set Ads = Nothing
		If Err.Number <> 0 Then'如若保存失败则退出Function
			Err.Clear
			Response.Write "Error:" & BV_LocalFileName & " Save Failed <br>"
		Else
			SaveRemoteFile = True
		End If
	End Function
	
	
	
	
	'$ 函数: HtmlCharset(Cset)
	'  作用: 根据编码Cset返回对应函数GetHttpPage(HttpUrl,Coding)中Coding的值
	'  参数: { Cset }网页的编码
	'  结果: 默认返回 0
	'        否则根据Cset的值返回 Cset=gb2312 : 0 、 Cset=utf-8 : 1 、 Cset=big5 : 2 、Cset=gbk : 3
	Function HtmlCharset(Cset)
		HtmlCharset=0
		If Cset="" or IsNull(Cset) Then
			Exit Function
		End If
		Cset=LCase(Cset)
		Select Case Cset
			Case "gb2312" : HtmlCharset=0
			Case "utf-8" : HtmlCharset=1
			Case "big5" : HtmlCharset=2
			Case "gbk" : HtmlCharset=3
			'Case "gbk" : HtmlCharset=3
			Case else : HtmlCharset=0
		End Select
	End Function
	
	'$ 函数: GetHttpPage(HttpUrl,Coding)
	'  作用：获取网页源码
	'  参数：{ HttpUrl }要获取源码的网页地址
	'        { Coding  }编码 UTF-8,Big5,GBK,其他:GB2312
	Function GetHttpPage(HttpUrl,Coding)
		On Error Resume Next
		If IsNull(HttpUrl) = True Or Len(HttpUrl) < 18 Or HttpUrl = "" Then
			GetHttpPage = ""
			Exit Function
		End If
		Coding=Trim(Coding)
		If Coding = "" Then
			Coding="GB2312"
		End If
		Dim Http
		Set Http = Server.CreateObject("MSXML2.XMLHTTP")
		Http.Open "GET", HttpUrl, False
		Http.Send
		If Http.Readystate <> 4 Then
			GetHttpPage = ""
			Exit Function
		End If
		GetHttpPage = BytesToBstr(Http.ResponseBody,Coding)
		Set Http = Nothing
		If Err.Number <> 0 Then
			Err.Clear
		End If
	End Function

	' $函数：BytesToBstr(Body,Cset)
	'  作用：二进制转换成Cset编码字符
	'  参数：{Body}要转换的内容
	'        {Cset}字符编码
	'  结果: 已经安装 返回True
	Function BytesToBstr(Body,Cset)
		Dim Objstream
		Set Objstream = Server.CreateObject("adodb.stream")
		Objstream.Type = 1
		Objstream.Mode = 3
		Objstream.Open
		Objstream.Write Body
		Objstream.Position = 0
		Objstream.Type = 2
		Objstream.Charset = Cset
		BytesToBstr = Objstream.ReadText
		Objstream.Close
		Set Objstream = Nothing
	End Function

	' $函数：GetBody(ConStr, StartStr, OverStr, IncluL, IncluR)
	'  作用：截取字符串
	'  参数：{ ConStr } 被截取的原字符串
	'        { StartStr } 开始字符串
	'        { OverStr }  结束字符串
	'        { IncluL } True : 返回的结果包含StartStr字符串    False : 返回的结果不包含StartStr字符串
	'        { IncluR } True ：返回的结果包含OverStr字符串     False ：返回的结果不包含OverStr字符串
	Function GetBody(ConStr, StartStr, OverStr, IncluL, IncluR)
		If ConStr = "$False$" Or ConStr = "" Or IsNull(ConStr) = True Or StartStr = "" Or IsNull(StartStr) = True Or OverStr = "" Or IsNull(OverStr) = True Then
			GetBody = "$False$"
			Exit Function
		End If
		Dim Start, Over
		Start = InStrB(1, ConStr, StartStr, vbBinaryCompare)
		If Start <= 0 Then
			Start = InStrB(1, ConStr, Replace(StartStr, vbCrLf, Chr(10)), vbBinaryCompare)
			If Start <= 0 Then
				Start = InStrB(1, ConStr, Replace(StartStr, vbCrLf, Chr(13)), vbBinaryCompare)
				If Start <= 0 Then
					GetBody = "$False$"
					Exit Function
				Else
					If IncluL = False Then
						Start = Start + LenB(StartStr)
					End If
				End If
			Else
				If IncluL = False Then
					Start = Start + LenB(StartStr)
				End If
			End If
		Else
			If IncluL = False Then
				Start = Start + LenB(StartStr)
			End If
		End If
		Over = InStrB(Start, ConStr, OverStr, vbBinaryCompare)
		If Over <= 0 Or Over <= Start Then
			Over = InStrB(Start, ConStr, Replace(OverStr, vbCrLf, Chr(10)), vbBinaryCompare)
			If Over <= 0 Or Over <= Start Then
				Over = InStrB(Start, ConStr, Replace(OverStr, vbCrLf, Chr(13)), vbBinaryCompare)
				If Over <= 0 Or Over <= Start Then
					GetBody = "$False$"
					Exit Function
				Else
					If IncluR = True Then
						Over = Over + LenB(OverStr)
					End If
				End If
			Else
				If IncluR = True Then
					Over = Over + LenB(OverStr)
				End If
			End If
		Else
			If IncluR = True Then
				Over = Over + LenB(OverStr)
			End If
		End If
		GetBody = MidB(ConStr, Start, Over - Start)
	End Function

End Class
%>